open Variable
open Type
open List

let f_args_type  = ref [];;

let rec get_args name args_list =
  match args_list with
    [] -> error "impossible !"
  | (name2, args_t)::tail ->
      if (compare name name2 == 0)
        then args_t
      else get_args name tail
;;

(* return type of an expression 
NOTE : this function is duplicated because ast type is different,
a way to avoid that is to save all this informations in ast
but I prefer not to do it because ast would be too big and
it would contains too many informations *)

let rec get_expr_type expr =
  match expr with
      T3_Int(_) -> TInt
    | T3_Float(_) -> TFloat
    | T3_Bool(_) -> TBool
    | T3_String(_) -> TString
    | T3_Array(_) -> TArray
    | T3_Binary(e1,op,e2) ->
    let t1 = get_expr_type e1
    and t2 = get_expr_type e2 in
    let t =
      if (t1 = t2) then t1
      else if (t_is_obj t1) then t2
      else if (t_is_obj t2) then t1
      else if (t1 = TNil && t2 != TNil) then t2
      else if (t1 != TNil && t2 = TNil) then t2
      else error "get_expr_type : huhu" in

      begin match op with
        "&&" -> if ((t1 = TBool || t_is_obj t1) && (t2 = TBool || t_is_obj t2) ) then TBool else raise TypeError
      | "||" -> if ((t1 = TBool || t_is_obj t1) && (t2 = TBool || t_is_obj t2) ) then TBool else raise TypeError
      | "==" -> t
      | "!=" -> t
      | "<" -> t
      | ">" -> t
      | "<=" -> t
      | ">=" -> t
      | "+" -> t
      | "-" -> t
      | "*" -> t
      | "**" -> if (t_is_obj t1) then TObjVar(t2) else TObjVar(t1)
      | "/" -> t
      | _ -> error ("undefined binary operator `"^op^"`\n")
      end
    | T3_Function(name, arg_list) -> get_var_type name (* check args *)
    | T3_Var(_) ->  get_var_type (get_name_t3 expr)
  | _ -> error "error in get_expr_type : weird expr"
;;

let t_is_obj t =
  match t with
    TObjVar(_) -> true
  | _ -> false
;;

let rec get_type_string t =
  match t with
    TInt -> "int"
  | TFloat -> "float"
  | TBool -> "bool"
  | TString -> "string"
  | TArray -> "array"
  | TNil -> "all"
  | TObjVar(t2) -> get_type_string t2
  | TArray_index -> "todo" 
  | TArray_int -> error "unexpected type in get_type_string"
;;

(* wrap function to transform an "simple" type into ObjVar*)
let wrap e =
  let t = get_expr_type e in
    if ( not (t_is_obj t)) 
      then begin
      (*print_string "need to wrap an array !!\n\n";*)
      let f = ("wrap_from_"^get_type_string t) in
        T3_Function(f, [e])
    end else
      e
;;

(* function that check args in a function, when necessary
arguments are wrapped.
NOTE : this check can probably be done during inference,
but I don't have time to check this ^^ *)
let rec check_args args args_decl =
  match args, args_decl with
    [],[] -> []
  | [],_ -> error "too few arguments in function"
  | _, [] -> error "too many arguments in function"
  | head::tail, (name2, t)::tail2 ->
    print_string (get_type_string t);
    let t1 = get_expr_type head in
      if ( (not (t_is_obj t1)) && (t_is_obj t)) 
        then begin
        (*print_string "need to wrap !!\n\n";*)
        let f = ("wrap_from_"^get_type_string t1) in
          T3_Function(f, [head])::(check_args tail tail2)
      end else if ((not (t_is_obj t)) && (t_is_obj t1)) 
        then begin
        let f = ("get_var_"^get_type_string t) in
          T3_Function(f, [head])::(check_args tail tail2)
      end else
        head::(check_args tail tail2)
;;



(* type all variable in expression expr to type t*)
let rec type_expr t expr = 
  match expr with
    T3_Var(name) -> if (is_obj name) 
          then begin
            let f_name = ("get_var_"^get_type_string t) in
            T3_Function(f_name, [expr])
          end else
            expr;
  | T3_Binary(e1, op, e2) ->
    let new_e1 = type_expr t e1
    and new_e2 = type_expr t e2 in
    T3_Binary(new_e1, op, new_e2)
  | T3_Unary(op,e) ->
    let new_e = type_expr t e in
    T3_Unary(op, new_e)
  | T3_Function(name, args) -> print_string "ijij"; if (is_obj name) 
          then begin
            let f_name = ("get_var_"^get_type_string t) in
            T3_Function(f_name, [expr])
          end else expr;
  | _ -> expr
;;

(* transform var which can have multiple type in Object *)
(* transforme object assignment *)
let rec to_object ast =
  match ast with
    [] -> []
  | head::tail ->
    begin match head with
      T3_Typed_Assignment(t, var, e) ->
      let name = get_name_t3 var in
      if (is_obj name)
        then begin
        print_string ("ass1 "^get_name_t3 var);
        let new_e = to_object [e]
        and f_name = ("set_var_"^get_type_string t) in
        let new_e2 = type_expr t (hd new_e) in
  
        let new_assgn = T3_Function(f_name, [T3_Pointer(name) ; new_e2]) in
          new_assgn::(to_object tail)
      end else if (t = TArray)
        then begin
        let ar = begin match e with
               T3_Array(x) -> x;
             | _ -> error "should  rewrite that !"
             end in
        let new_name = get_new_name () in
        let new_e = T3_Array(List.map wrap ar) in
        (T3_Typed_Assignment(TArray_int, T3_Var(new_name), new_e))::
        (T3_Function("add_array",
			[T3_Pointer(name) ; T3_Var(new_name) ; T3_Int(List.length ar)]))
		::(to_object tail)
      end else begin
		print_string ("var__"^name);
        let new_e = type_expr t (hd (to_object [e])) in
        (*if ( t != (get_var_type name))
           then begin
           let f_name = ("get_var_"^get_type_string (get_var_type name)) in
             T3_Typed_Assignment(t, var, (T3_Function(f_name, [new_e])))::(to_object tail)
       end else*)
          (T3_Typed_Assignment(t, var, new_e))::(to_object tail)
      end
    | T3_Struct_If(if_list) -> T3_Struct_If(List.map to_object_if if_list )
                                 ::(to_object tail)
    | T3_Var(name) ->
      if (is_obj name) 
      then begin
        let f_name = ("get_var_"^get_type_string (get_var_type name)) in
        T3_Function(f_name, [T3_Var(name)])::(to_object tail)
      end else head::(to_object tail)
    | T3_Binary(e1, op, e2) ->
        (* if e1 and e2 have different types or are objVar, replace operator by
        an generic function that do the job 
        only ** operator is implemented here as a "proof of concept" 
        Of course here ** operator isn't defined in C so every use of this
        operator are replaced but for +, - ... we should replace there by
        generic function call only when C behaviour is different*)
        let new_e1 = hd (to_object [e1])
        and new_e2 = hd (to_object [e2]) in
        print_string "in binary!\n";
        (if ( String.compare op "**" == 0 )
            then begin
            print_string "call generic !\n";
            T3_Function("generic_pow", [wrap new_e1; wrap new_e2])  
       end else (* use normal arithmetic operator *)
            let t = get_expr_type head in
            type_expr t head)
        ::(to_object tail)
    | T3_For(var, beg, end_, body) ->
        let new_body = to_object body in
        T3_For(var, beg, end_, new_body)::(to_object tail)
    | T3_While(cond, body) ->
        let new_cond = to_object [cond]
        and new_body = to_object body in
          T3_While(hd new_cond, new_body)::(to_object tail)
    | T3_Typed_Decl_Function(name, args, body) ->
        print_string ("decl_fun : "^name^"\n");
        f_args_type := (name, args)::!f_args_type;
        let old_env = !env in
          List.iter (function (name, t) -> add_var t name) args;
          List.iter (function T3_Typed_Decl_Var(name2, t2) -> add_var t2 name2
                      | _ -> ()) body;
        let new_body = to_object body in 
          env := old_env;
        T3_Typed_Decl_Function(name, args, new_body)::(to_object tail)
    | T3_Function(name, args) -> 
      (* check args type *)
      print_string ("call "^name);
      let new_args = check_args args (get_args name !f_args_type) in
      T3_Function(name, new_args)::(to_object tail)
    | T3_Return(e) -> T3_Return(hd (to_object [e]))::(to_object tail)
    | _ -> head::(to_object tail)
    end
and to_object_if expr = 
  match expr with
      T3_If(cond, expr_list) -> let new_expr = (List.map to_object [expr_list])
                and new_cond = to_object [cond] in
                    (T3_If(hd new_cond, hd new_expr))
    | T3_Else(expr_list) -> let new_expr = List.map to_object [expr_list] in
                  (T3_Else(hd new_expr))
;;

